Aminet 1/Aminet - June 1993 [Walnut Creek].iso/ab20/datacomm/vlt_5045.lzh/rexx/VLT2Provec.pvrx

Text File | 1991-02-05 | 9.2 KB | 359 lines

/** VLT2Provec.pvrx
*
*   This routine takes a VLT command file containing "Tek...." commands
*   and translates them to instructions for Provector. This routine
*   must be called from Provector using "Rexxecute", or you may add it
*   as a menu option.
*
*   The VLT command file is prepared by selecting the VLT option
*   "Save as Script Commands" option from the Image menu of the the
*   VLT graphics screen.
*
*   When you run this routine from Provector, it will ask you for a file
*   name. It will then start translating the commands and occasionally it
*   will update the screen. Depending on the complexity of the plot, this
*   may take some time.
*
*   Currently, not every VLT command is handled completely/correctly.
*   Some commands are not implemented. If you find you need to make some
*   enhancements, go right ahead!
*
*       Willy Langeveld, 4 February 1991.
*
**/
   OPTIONS results
   address 'ProVector'
/*
*   Get the file name and open it
*/
   'GetStr "VLT command file to import:" "OK" "Abort"'
   file = result
   if ~open("INFILE",file) then do
      'GetBool "Couldn''t open file" "OK" "Eyup"'
      exit 0
   end
/*
*   Set page dimensions
*/
   pdims.x1 = 0
   pdims.y2 = 0
   pdims.x2 = 8.5
   pdims.y1 = 8.5

   'SetPageSize' pdims
/*
*   Scale factors.
*/
   xscale = 8.5/4096
   yscale = 8.5/4096
/*
*   Make a background object
*/
   pts.0.x = 0
   pts.0.y = 0
   pts.1.x = 0
   pts.1.y = 8.5
   pts.2.x = 8.5
   pts.2.y = 8.5
   pts.3.x = 8.5
   pts.3.y = 0
   'Polygon' 4 pts

   BackGround = result

   'ChangeFillVal '  BackGround 0
   'ChangeEdgeType ' BackGround 0
/*
*   Initialize some variables
*   Picture. contains the attributes that we can't set immediately.
*/
   Picture. = ""
   Picture.Linepen = 1
   Picture.Textpen = 1
/*
*   npts is the number of points in the pts. array.
*/
   npts = 0
/*
*   LineMode = 1 means we're drawing a line object
*   LineMode = 2 means we're drawing a filled object
*/
   LineMode = 1
/*
*   Some marker types. This really needs to be improved, but then,
*   who uses markers anyway...
*/
   MarkerTypes.0  = "."
   MarkerTypes.1  = "."
   MarkerTypes.2  = "+"
   MarkerTypes.3  = "*"
   MarkerTypes.4  = "O"
   MarkerTypes.5  = "X"
   MarkerTypes.6  = "O"
   MarkerTypes.7  = "O"
   MarkerTypes.8  = "X"
   MarkerTypes.9  = "X"
   MarkerTypes.10 = "X"
/*
*   Set the upper 128 colors to Tektronix colors
*/
   do i = 1 to 5
      do j = 1 to 5
         do k = 1 to 5
            rgb.r = i * 51
            rgb.g = j * 51
            rgb.b = k * 51
            pen = (i-1) * 25 + (j-1) * 5 + k + 127
            'SetColor ' pen rgb
         end
      end
   end
/*
*   Reset the timer
*/
   call time('r')
/*
*   Main loop over VLT's commands
*/
   do i = 1 while ~eof("INFILE")
      data = readln("INFILE")

      parse var data 'Tek' cmd xx yy zz .
      cmd = upper(cmd)
/*
*   Every 5 seconds, fix the display
*/
      if time('e') > 5 then do
         'Repair'
         call time('r')
      end
/*
*   We should finish up the current object if the command is not MOVE,
*   DRAW or POLYGON. These do their own cleanups
*/
      if (cmd ~= "MOVE") & (cmd ~= "DRAW") & (cmd ~= "POLYGON") then do
         if npts ~= 0 then do
            if      LineMode = 1 then call DoPolyLine
            else if LineMode = 2 then call DoPolygon
            npts = 0
         end
      end
/*
*   Now handle the commands. Some of them are quite weird...
*   There are some we don't handle (they do a "nop").
*/
      select
         when cmd = "MOVE" then do
            if LineMode = 1 then do
               if npts ~= 0 then call DoPolyLine
               pts.0.x = xx * xscale
               pts.0.y = yy * yscale
               npts = 1
            end
            else if LineMode = 2 then do
               pts.npts.x = xx * xscale
               pts.npts.y = yy * yscale
               npts = npts + 1
            end
         end
         when cmd = "DRAW" then do
            pts.npts.x = xx * xscale
            pts.npts.y = yy * yscale
            npts = npts + 1
         end
         when cmd = "MARKER" then do
            zz = Picture.MarkerType
            call DoChar(1)
         end
         when cmd = "CHARACTER" then do
            call DoChar(0)
         end
         when cmd = "ERASE" then do
            nop
         end
/*
*   OLDMODE is no longer used by VLT, though it is still supported for
*   old pictures. Note that there is some overlap between OLDMODE,
*   MODE, PATTERN, and MODEPATTERN
*/
         when cmd = "OLDMODE" then do
            Picture.Linepen = xx
            Picture.Textpen = xx
         end
         when cmd = "MODE" then do
            if      yy = 0 then Picture.Linepen = xx
            else if yy = 1 then Picture.Textpen = xx
            else if yy = 2 then do
               Picture.Fillpen  = xx // 256
               Picture.Filltype = 1

               if xx > 255 then do
                  if      bittst(d2c(xx), 8)  then Picture.Filltype = 2
                  else if bittst(d2c(xx), 9)  then do
                     Picture.Filltype = 1
                     Picture.Fillpen  = Picture.Fillpen + 128
                  end
                  else if bittst(d2c(xx), 10) then Picture.FillType = 0
               end
            end
            else if yy = 3 then Picture.AluMode = xx
         end
         when cmd = "PATTERN" then do
            Picture.Pattern = xx
         end
         when cmd = "MODEPATTERN" then do
            Picture.Linepen = xx
            Picture.Pattern = yy
         end
         when cmd = "INIT" then do
            nop
         end
/*
*   Here we decode the color values. Note that red and green are in the
*   upper and lower nybbles of the yy value.
*/
         when cmd = "COLOR" then do
            rgb.r = yy / 16 % 1 * 17
            rgb.g = yy // 16 * 17
            rgb.b = zz * 17
            'SetColor 'xx rgb
         end
/*
*   Like some other commands, POLYGON comes in two flavors distinguished
*   by one of the args, here it's xx. Not correctly handled here is the
*   case where there are "polygons within polygons".
*/
         when cmd = "POLYGON" then do
            if xx = 1 then do
               if LineMode = 1 then do
                  if npts ~= 0 then call DoPolyLine
                  npts = 0
               end
               LineMode = 2
               Picture.PolyOutline = yy
            end
            else if xx = 0 then do
               if npts ~= 0 then call DoPolygon
               npts = 0
               LineMode = 1
            end
         end
         when cmd = "TEXTJAM" then do
            Picture.TextJAM = xx
         end
         when cmd = "TEXTSIZE" then do
            Picture.TextSize.x     = xx
            Picture.TextSize.y     = yy
            Picture.TextSize.Space = zz
         end
         when cmd = "MARKERTYPE" then do
            Picture.MarkerType = MarkerTypes.xx
         end
         when cmd = "TEXTPATHANGLE" then do
            if      yy = 0 then Picture.TextAngle = xx
            else if yy = 1 then Picture.TextPath  = xx
         end
         when cmd = "BACKGROUNDCOLOR" then do
            'ChangeFillVal ' BackGround xx
         end
         when cmd = "SETWINDOW" then do
            if zz = 1 then do
               Picture.Corner.1.x = xx
               Picture.Corner.1.y = yy
               xscale = 8.5/(Picture.Corner.1.x - Picture.Corner.0.x + 1)
               yscale = xscale
            end
            else if zz = 0 then do
               Picture.Corner.0.x = xx
               Picture.Corner.0.y = yy
            end
         end
         when cmd = "GRAPHCHAR" then do
            call DoChar(1)
         end
/*
*   We don't handle PIXEL operations yet.
*/
         when cmd = "PIXELRECT"  then do
            nop
         end
         when cmd = "PIXELCOPY"  then do
            nop
         end
         when cmd = "PIXELWRITE" then do
            nop
         end
         otherwise do
            nop
         end
      end
   end

/*
*   We reached the end of file. Have to finish current object
*/
   if npts ~= 0 then do
      if      LineMode = 1 then call DoPolyLine
      else if LineMode = 2 then call DoPolygon
   end
/*
*   Final repair
*/
   'Repair'
   address command 'say "I am Finished"'
   call delay(50)
   address command 'say "I said, I am Done"'
   exit


/**
*
*   Finish up a line object
*
**/
DoPolyLine:
   'PolyLine' npts pts
   object = result
   'ChangeEdgeVal ' object Picture.Linepen
   return

/**
*
*   Finish up a polygon object
*
**/
DoPolygon:
   'Polygon' npts pts
   object = result
   'ChangeFillType ' object Picture.Filltype
   'ChangeFillVal '  object Picture.Fillpen
   'ChangeEdgeType ' object Picture.PolyOutline
   return

/**
*
*   Display a character
*
**/
DoChar:
   arg graph

   width  = Picture.TextSize.x * xscale
   height = Picture.TextSize.y * yscale

   if graph = 1 then angle = Picture.TextAngle
   else              angle = 0

   'Text ' '"'d2c(zz)'"' xx*xscale yy*yscale width height angle
   textobj = result
/*
*  Change the string to the desired font
*  Reflect to handle change in default coordinate system
*  Then replot the changes
*  Here we hit a provector bug if the pagesize is too big
*/
   'ChangeFont ' textobj ' simple_stroke'
   'Size ' textobj xx*xscale yy*yscale ' 1 -1'
   'ChangeEdgeVal ' textobj Picture.Textpen
   return